COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 DESTRUCTIVE OPERATION BENCHMARK
C00007 ENDMK
C⊗;
;;; DESTRUCTIVE OPERATION BENCHMARK

(DECLARE (LOCALVARS . T))



(DEFINEQ
  (DESTRUCTIVE
   (LAMBDA (N M) 
     ((LAMBDA (L) 
	((LAMBDA (G0011) 
	   (PROG (I) 
		 (SETQ I G0011)
	    LOOP (COND ((IEQP I 0) (RETURN NIL)))
		 (COND
		  ((NULL (CAR L))
		   ((LAMBDA (G0012) 
		      (PROG (L) 
			    (SETQ L G0012)
		       LOOP (COND ((NULL L) (RETURN NIL)))
			    (OR (CAR L) (RPLACA L (CONS NIL NIL)))
			    (NCONC
			     (CAR L)
			     ((LAMBDA (G0013 G0014) 
				(PROG (J A) 
				      (PROGN (SETQ J G0013)
					     (SETQ A G0014))
				 LOOP (COND ((IEQP J 0) (RETURN A)))
				      ((LAMBDA (G0013 G0014) 
					 (PROGN (SETQ J G0013)
						(SETQ A G0014))
					 (GO LOOP))
				       (IDIFFERENCE J 1)
				       (SETQ A (CONS NIL A)))))
			      M
			      NIL))
			    ((LAMBDA (G0012) (SETQ L G0012) (GO LOOP))
			     (CDR L))))
		    L))
		  (T
		   ((LAMBDA (G0015 G0016) 
		      (PROG (L1 L2) 
			    (PROGN (SETQ L1 G0015) (SETQ L2 G0016))
		       LOOP (COND ((NULL L2) (RETURN NIL)))
			    (RPLACD
			     ((LAMBDA (G0017 G0018) 
				(PROG (J A) 
				      (PROGN (SETQ J G0017)
					     (SETQ A G0018))
				 LOOP (COND ((IEQP J 0) (RETURN A)))
				      (RPLACA A I)
				      ((LAMBDA (G0017 G0018) 
					 (PROGN (SETQ J G0017)
						(SETQ A G0018))
					 (GO LOOP))
				       (IDIFFERENCE J 1)
				       (CDR A))))
			      (IQUOTIENT (LENGTH (CAR L2)) 2)
			      (CAR L2))
			     ((LAMBDA (N) 
				(COND
				 ((IEQP N 0) (RPLACA L1 NIL) (CAR L1))
				 (T
				  ((LAMBDA (G0019 G0020) 
				     (PROG (J A) 
					   (PROGN (SETQ J G0019)
						  (SETQ A G0020))
				      LOOP (COND
					    ((IEQP J 1)
					     (RETURN
					      (PROG1
					       (CDR A)
					       (RPLACD A NIL)))))
					   (RPLACA A I)
					   ((LAMBDA (G0019 G0020) 
					      (PROGN (SETQ J G0019)
						     (SETQ A G0020))
					      (GO LOOP))
					    (IDIFFERENCE J 1)
					    (CDR A))))
				   N
				   (CAR L1)))))
			      (IQUOTIENT (LENGTH (CAR L1)) 2)))
			    ((LAMBDA (G0015 G0016) 
			       (PROGN (SETQ L1 G0015) (SETQ L2 G0016))
			       (GO LOOP))
			     (CDR L1)
			     (CDR L2))))
		    L
		    (CDR L))))
		 ((LAMBDA (G0011) (SETQ I G0011) (GO LOOP))
		  (IDIFFERENCE I 1))))
	 N))
      ((LAMBDA (G0021 G0022) 
	 (PROG (I A) 
	       (PROGN (SETQ I G0021) (SETQ A G0022))
	  LOOP (COND ((IEQP I 0) (RETURN A)))
	       ((LAMBDA (G0021 G0022) 
		  (PROGN (SETQ I G0021) (SETQ A G0022))
		  (GO LOOP))
		(IDIFFERENCE I 1)
		(SETQ A (CONS NIL A)))))
       10
       NIL)))))

(TIMER TIMIT (DESTRUCTIVE 600. 50.))